Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Pascal/Libraries/Utilities/Utilities.p

Text File | 1994-05-05 | 40.4 KB | 1,185 lines | [TEXT/R*ch]

{Utilities unit ©1994 by Sean Crist ([e-mail]).  (Soon I'll have a new address on some machine}
{in the domain upenn.edu; try reaching me there if chopin.udel.edu doesn't work.) I'd appreciate any comments or }
{bug reports.  This code may be freely used for any purpose, except that military use is expressly prohibited.}

{About this unit:}
{This is a real grab bag of utility routines which I've written and find handy; most are routines I think should have}
{been a part of the Toolbox.}

{Most of the documentation is in amidst the interface declarations.  I know these are very densely written and }
{look a little daunting, but I encourage you to read through them; you may find some things to save you coding time.}

unit Utilities;

interface

{Mathematical operations on rectangles and points.}

{The following two routines are covert a rectangle back and forth between local and global coordinates.}
    procedure LocalToGlobalRect (var TheRect: Rect);
    procedure GlobalToLocalRect (var TheRect: Rect);
{CenterRect moves the first rectangle, centering it inside the second rectangle.}
    procedure CenterRect (var MoveRect: Rect; StillRect: Rect);
{RectCenter figures out what the center point of a rectangle is.}
    function RectCenter (TheRect: Rect): Point;
{MoveRgnTo moves a region so that its upper left corner is the same as that of ToRect.  MoveRgnTo}
{does no scaling; if the rect containing WhichRgn isn't the same size as ToRect, then the lower right}
{corners won't match.}
    procedure MoveRgnTo (WhichRgn: RgnHandle; ToRect: Rect);


{Operations on strings}

{ParamString inserts strings into another string, just as ParamText inserts text into dialogs. For example, }
{ParamString could insert the string 'My Filename' into the string 'Save changes to “^0” before closing?'}
{This is handy if you want to keep alert messages in STR# resources rather than have a separate alert for }
{everything, but still want to be able to insert text.}
{MainString is the string containing the ^0, ^1, ^2, ^3 placeholders; the others are respectively inserted into MainString.}
    procedure ParamString (var MainString: Str255; FirstParam, SecondParam, ThirdParam, FourthParam: Str255);

{EllipsisString truncates strings like 'Really obnoxiously long filename' to 'Really obnox…'}
{It takes a string and a pixel width.  Given the text font, size etc. of the current port, EllipsisString}
{trucates the string and puts ellipses (…) at the end so that the total string is not wider than PixelWidth.  If}
{SourceString is already shorter than PixelWidth, EllipsisString just returns SourceString intact.}
    function EllipsisString (SourceString: Str255; PixelWidth: Integer): Str255;


{The following routines create packed lists of strings in the same format of STR# resources. (I've}
{never actually tested to make sure you can create STR# resources this way, but I believe you could.)}
{This is handy for doing things like making a symbol table when parsing text.}

{This function creates a new empty STR.}
    function CreateNewSTR (var TheSTR: Handle): Boolean;
{This function adds a new string to the end of a STR and returns its index}
    function AddToSTR (TheSTR: Handle; TheString: string): Integer;
{This function searches for a given string and returns its index.}
    function FindInSTR (TheSTR: Handle; TheString: string): Integer;
{This function, given an index, returns a string.}
    function ExtractSTR (TheSTR: Handle; TheIndex: Integer): Str255;



{Relatively low-level routines for posting an alert.}

{MiscAlert posts the string AlertString in an alert that just has an OK button.}
    procedure MiscAlert (AlertString: Str255);
{MiscInquiry posts AlertString in an alert that has an OK button and a cancel button.}
{It returns the number of the button pushed.}
    function MiscInquiry (AlertString: Str255): integer;
{MiscAlertSTR is same as MiscAlert, but we take the ID and index into a STR# resource and display that string.}
    procedure MiscAlertSTR (rsrcID, index: Integer);
{MiscInquirySTR is same as MiscInquiry, but we take the ID and index into a STR# resource and display that string.}
    function MiscInquirySTR (rsrcID, index: Integer): integer;

{These are the resource IDs of the ALRTs used by MiscAlert and MiscInquiry.  These should both contain}
{a large static text item with the text '^0' for ParamText, plus an appropriate icon.}
    const
        OkAlert = 128; {Has an OK button}
        OkAndCancelAlert = 129; {Has an OK button and a Cancel button.}



{Error checking and reporting}

{doOSErr is our lowest-level error reporting routine.  It takes any OS error code and displays an appropriate alert.}
{We get the error text from a STR# resource; if the error is one for which we have no STR# entry, we just}
{say something like 'An unexpected error has occurred' plus the error code.  (You should edit this routine}
{to customize it for your application and should create an appropriate STR# resource.)}
    procedure doOSErr (result: OSErr);  {Post an error message.}

{The following group of error-checking routines are all written with the same aim: to make other code}
{as sturdy but concise as possible by relieving the code of most of its error-checking work. In every routine }
{which can fail, I define a boolean OkSoFar which is initially set to TRUE; then I write the rest of the routine }
{in paragraphs like the following:}
{                                                                                                                    }
{                if OkSoFar then                                                                                    }
{                    begin                                                                                            }
{                        SomeMemoryManagerCallWhichCanFail;                                                }
{                        OkSoFar := TestMemErr;    {or whatever is appropriate}
{                    end;                                                                                            }
{                                                                                                                    }
{The following group of routines are all consonant with this coding style, each checking for a certain kind}
{of error and returning the boolean FALSE if an error was detected.}

{TestMemErr checks the MemErr global and returns TRUE if the error is 0 (no error).  If there is an error,}
{TestMemErr calls doOSErr to post an appropriate alert and returns FALSE.  (The calling routine thus sets}
{its OkSoFar variable to FALSE, and falls through without doing anything else.)}
    function TestMemErr: Boolean;
{TestResErr is same an TestMemErr but checks for resource errors instead.}
    function TestResErr: Boolean;
{TestNilRsrc makes sure a handle is a good one, returning FALSE is the handle is nil.}
    function TestNilRsrc (TheRsrc: Handle): Boolean;
    const
        GotNilResource = 7000;  {A private 'OS error' which we use to mean that GetResource got a nil handle.}
{An obnoxious feature of the Toolbox is that if you try to GetResource a non-existant resource, there will}
{be no error returned, and you just get a nil handle.  GetResOK both checks for an operating system}
{error (TestResErr) AND checks to make sure the resource handle you got back isn't nil (TestNilRsrc).}
    function GetResOK (TheRsrc: Handle): Boolean;
{TestOSResult is for Toolbox calls which are functions returning an OS result, so you can write paragraphed}
{code of the form above with lines like OkSoFar := TestOSResult(SomeToolboxFunctionReturningAnOSresult)}
    function TestOSResult (Result: Integer): Boolean;
{You can call Preflight before undertaking some memory-hungry operation to make sure you have enough}
{memory to complete it.  MemNeeded is the minimum amount of memory needed to complete the operation;}
{Preflight returns TRUE if there is enough.  If there isn't enough, Preflight returns FALSE and also puts up an}
{alert with a message of the sort 'There isn't enough memory to do X'.  FailStringIndex is an index to a STR#}
{resource containing all the failure messages for Preflight alerts; you'd want one such string for each}
{kind of operation.}
    function Preflight (MemNeeded: LongInt; FailStringIndex: Integer): Boolean;




{Routines having to do with dialogs}

{My strategy for drawing user items in modeless dialogs is as follows.  When I open the dialog, I call LinkUserItem}
{on each user item in the dialog.  This sets the pointer for the update routines for these items all to one routine,}
{UpdateUserItem, defined below.  When the dialog gets an update event, the dialog manager will thus call my }
{UpdateUserItem procedure to have to user item redrawn.  UpdateUserItem in turn calls an external routine }
{which you'll have to write yourself; your routine should redraw the item.}
    procedure LinkUserItem (WhichDialog: DialogPtr; WhichItem: Integer);

{The following routines are all abbreviations for GetDItem or SetDItem calls.  For example, if you only want the}
{rect of a particular dialog item, and you want to use GetDItem,  you'd usually have to have DummyHandle and}
{DummyText variables as well.}
{The following routines can make your code more concise, giving you just the information you need about a dialog}
{item and nothing more.}
{GetDRect returns the rect of a dialog item.}
    function GetDRect (theDialog: DialogPtr; theItem: Integer): Rect;
{GetDControl returns a ControlHandle for a dialog item which is a control.}
    function GetDControl (theDialog: DialogPtr; theItem: Integer): ControlHandle;
{GetDHandle returns the handle for a dialog item.}
    function GetDHandle (theDialog: DialogPtr; theItem: Integer): Handle;
{SetDText changes the text of a dialog item.}
    procedure SetDText (theDialog: DialogPtr; theItem: Integer; theString: Str255);
{SetDRect changes the rect of a dialog item.  Note: if you are moving a dialog item, it's up to you to InvalRect the}
{old rect and the new rect.}
    procedure SetDRect (theDialog: DialogPtr; theItem: Integer; theRect: Rect);


{Routines having to do with the cursor}

{Call InitWatch when your program starts up to set the global WatchHandle to the watch cursor.}
    procedure InitWatch;
{ShowWatch is just like InitCursor, except that it changes the cursor to a plain watch.}
    procedure ShowWatch;
{The next three routines are for an animated spinning watch.  Call StartSpinningWatch to load the}
{watch cursors into memory (you must add these resources to your file, of course); call StopSpinningWatch}
{watch when you're finished with the spinning watch to deallocate the memory allocated by StartSpinningWatch.}
{In between, call SpinWatch as often as possible.  SpinWatch keeps track of the ticks, and keeps the watch}
{spinning at a constant speed, regardless of how often you call it.  Don't call SpinWatch unless you've called}
{StartSpinningWatch first!}
    procedure StartSpinningWatch;
    procedure SpinWatch;
    procedure StopSpinningWatch;

{Variables used by the above routines.}
    var
        WatchHandle: CursHandle;
        SpinningWatchHandle: array[1..7] of CursHandle;
        SpinningWatchTimer: LongInt;
        SpinningWatchState: Integer;



{Routines for drawing pop-up menus.  Yeah, I know there's a pop-up CDEF in System 7, but what if you still want to}
{support earlier systems?}

{Call InitPopUpTriangle before calling DrawPopUpMenu.  InitPopUpTriangle creates a region for the down-triangle.}
{You could call this from your program's initialize procedure.}
    procedure InitPopUpTriangle;
{DrawPopupMenu draws a popup menu with a box, drop-shadow, and down-pointing triangle in TheRect.}
{The TitleString is drawn into the menu box.  EllipsisString is called to truncate TitleString in case it is too long.}
    procedure DrawPopupMenu (StartRect: Rect; TitleString: Str255);
{RenamePopupMenu is like DrawPopupMenu, but it only redraws the name of the menu. If you're changing the text }
{in the menu after the user has made a selection, it's better to call RenamePopupMenu to avoid the flicker of }
{redrawing the whole menu.}
    procedure RenamePopupMenu (TheRect: Rect; TitleString: Str255);
{DoDialogPopUp is handy when you've gotten a mousedown in a popup menu in a dialog, detected by your filter function.}
{WhichDialog is the dialog where the mouse hit the menu.  TitleDItem is the title of the menu, a static text item; it will }
{be appropriately inverted.  PopUpDItem is the dialog item which is the menu itself (a user item).  StartSelection is the }
{item in TheMenu which should appear right above PopUpDItem.  TheMenu is the menu you want to pop up.  DoDialogPopUp }
{returns the menu item which was selected.}
    function DoDialogPopUp (WhichDialog: DialogPtr; TitleDItem, PopUpDItem, StartSelection: Integer; theMenu: MenuHandle): Integer;


{List Manager routines}

{The following are a simplification of the List Manager.  These routines are for making a list of text items.}
{CreateList creates a new list with no elements.}
    procedure CreateList (var TheListHandle: ListHandle; TheWindow: WindowPtr; TheRect: Rect);
{UpdateList redraws a list in response to an update event.}
    procedure UpdateList (TheListHandle: ListHandle);
{DoClick handles a click in the list rectangle.  If it was a double-click, we will return TRUE.}
    function DoClick (TheListHandle: ListHandle; TheWhere: Point): Boolean;
{TurnOffSelection turns off any hilited item.}
    procedure TurnOffSelection (TheListHandle: ListHandle);
{ListSelection returns the string currently selected; empty string if no selection.}
    function ListSelection (TheListHandle: ListHandle): string;
{AddCell adds a new cell, setting its text to NewString.}
    procedure AddCell (TheListHandle: ListHandle; NewString: str255);
{RenameCell changes the name of an existing cell}
    procedure RenameCell (TheListHandle: ListHandle; OldString, NewString: Str255);
{DeleteCell removes the cell with the given name from the list.}
    procedure DeleteCell (TheListHandle: ListHandle; TheString: string);
{DisposList gets rid of the list when we're done with it, cleaning up all the memory.}
    procedure DisposList (TheListHandle: ListHandle);


{To make a little up-down arrow control like that in the Alarm Clock desk accessory, create a dialog item}
{which is a PICT of the arrow control.  Check for mousedowns in this PICT in your filter function; if you get}
{such a mousedown, call ArrowClick.  ArrowClick acts very much like TrackControl, and returns one of the}
{constants below depending on where the user clicked. (This isn't a true control, of course, but it acts like one.)}
    function ArrowClick (ClickWhere: Point; ArrowRect: Rect): Integer;
    const
        ArrowNone = 0;  {ArrowNone is returned if the user dragged the mouse out of the arrow before releasing the button.}
        ArrowUp = 1;
        ArrowDown = 2;




{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

implementation


    procedure LocalToGlobalRect (var TheRect: Rect);
    begin
        LocalToGlobal(TheRect.TopLeft);
        LocalToGlobal(TheRect.BotRight);
    end;

    procedure GlobalToLocalRect (var TheRect: Rect);
    begin
        GlobalToLocal(TheRect.TopLeft);
        GlobalToLocal(TheRect.BotRight);
    end;

    procedure CenterRect;
        var
            MoveVCenter, MoveHCenter, StillVCenter, StillHCenter: Integer;
    begin
        MoveVCenter := MoveRect.left + MoveRect.right;
        MoveVCenter := MoveVCenter div 2;
        MoveHCenter := MoveRect.top + MoveRect.bottom;
        MoveHCenter := MoveHCenter div 2;
        StillVCenter := StillRect.left + StillRect.right;
        StillVCenter := StillVCenter div 2;
        StillHCenter := StillRect.top + StillRect.bottom;
        StillHCenter := StillHCenter div 2;
        OffsetRect(MoveRect, StillVCenter - MoveVCenter, StillHCenter - MoveHCenter);
    end;

{Figure out where the center point of a rectangle is.}
    function RectCenter;
        var
            TempPoint: Point;
    begin
        TempPoint.h := (TheRect.Right + TheRect.Left) div 2;
        TempPoint.v := (TheRect.Top + TheRect.Bottom) div 2;
        RectCenter := TempPoint;
    end;


    procedure MoveRgnTo (WhichRgn: RgnHandle; ToRect: Rect);
        var
            verticalOffset, horizontalOffset: Integer;
    begin
        verticalOffset := ToRect.top - WhichRgn^^.RgnBBox.top;
        horizontalOffset := ToRect.left - WhichRgn^^.RgnBBox.left;
        OffsetRgn(WhichRgn, horizontalOffset, verticalOffset);
    end;


{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}


{The following routine is similar to the Toolbox routine ParamText;  it takes a}
{string and inserts other strings into it.  I am writing this routine because}
{I prefer to put my alert messages in STR# resources rather than making a}
{slew of different ALRT resources.  This way, I can insert information into}
{the strings myself, and then put the finished string into the alert using ParamText.}
    procedure ParamString;
        var
            counter: Integer;
            NewString: Str255;
            GotCaret: Boolean;
    begin
        GotCaret := false;
        NewString := '';
        for counter := 1 to length(MainString) do
{If we got a caret last time through the loop, it might be ^0, ^1, ^2, or ^3, which}
{means we've got to insert the appropriate text.  So we look at the next}
{character and decide what to insert.}
            if GotCaret then
                begin
                    GotCaret := false;  {Get ready for next time.}
                    if MainString[counter] = '0' then
                        NewString := Concat(NewString, FirstParam)
                    else if MainString[counter] = '1' then
                        NewString := Concat(NewString, SecondParam)
                    else if MainString[counter] = '2' then
                        NewString := Concat(NewString, ThirdParam)
                    else if MainString[counter] = '3' then
                        NewString := Concat(NewString, FourthParam)
                end
{But if we didn't get a caret last time through the loop, see if we've got one this}
{time.}
            else if MainString[counter] = '^' then
                GotCaret := true
{But if it isn't a caret, then just copy the character into the new string.}
            else
                NewString := Concat(NewString, MainString[counter]);
        MainString := NewString;
    end;


    function EllipsisString (SourceString: Str255; PixelWidth: Integer): Str255;
        var
            Ellipsis: Str255;
            EllipsisLength: Integer;
            TargetLength: Integer;
            CumulativeString: Str255;
            Counter: Integer;
            done: Boolean;
    begin
{We assume that the appropriate port has been set, and then use the font and size for that}
{port to do our calculation.}
        if StringWidth(SourceString) < PixelWidth then
            EllipsisString := SourceString
        else
            begin
                Ellipsis := '…';
                EllipsisLength := StringWidth(Ellipsis);
                TargetLength := PixelWidth - EllipsisLength;
                CumulativeString := '';
                Counter := 0;
                done := false;
                while not done do
                    begin
                        if StringWidth(Concat(CumulativeString, SourceString[Counter])) >= TargetLength then
                            done := true
                        else
                            begin
                                Counter := Counter + 1;
                                CumulativeString := Concat(CumulativeString, SourceString[Counter]);
                            end;
                    end;
                EllipsisString := Concat(CumulativeString, Ellipsis);
            end;
    end;


{About the following four routines:  these routines are for compressing strings into}
{an array with the same structure as a STR# resource.  This is a way to save a lot}
{of memory which would go wasted if we stored lists of strings as arrays of Str255.}

    function CreateNewSTR (var TheSTR: Handle): Boolean;
        var
            TheNewSTR: Handle;
    begin
        TheNewSTR := NewHandle(2);   {Make a new handle the size of an integer.}
        if MemError <> 0 then   {Check for MemError like good boys and girls}
            begin
                doOSErr(MemError);
                CreateNewStr := false;   {Tell whoever called us that we've failed.}
            end
        else   {The memory was successfully allocated, so go ahead.}
            begin
                CreateNewStr := true;  {Tell whoever called us that we've succeeded.}
                TheSTR := TheNewSTR;
                StuffHex(TheNewSTR^, '0000');  {Initialize the number of strings to 0.}
            end;
    end;

{The following routine makes odd numbers into even numbers by adding one if necessary.}
    function MakeEven (OddInteger: Integer): Integer;
    begin
{If this is an even integer...}
        if OddInteger = ((OddInteger div 2) * 2) then
{...then just return the number we were given...}
            MakeEven := OddInteger
        else
{...but if this is an odd integer, add 1 to make it even.}
            MakeEven := OddInteger + 1;
    end;

{This function adds a new string to the end of a STR and returns its index.  If memory is}
{insufficient, we return -1.}
    function AddToSTR; {(TheSTR: Handle, TheString: string): Integer;}
        var
            OldNumberOfStrings, NewNumberOfStrings: Integer;
            NewStringEvenLength, StringLength: Byte;
            counter, CurrentOffset: Integer;
            ScratchPtr: Ptr;
            OldSize: LongInt;
            OkSoFar: Boolean;
    begin
        OkSoFar := true;  {Let's assume everything's going to be all right.}
{Figure out how big the old handle and the new string are.}
        NewStringEvenLength := MakeEven(Length(TheString) + 1);  {+1 for size byte}
        OldSize := GetHandleSize(TheSTR);
{Set the size of the handle and check for errors.}
        SetHandleSize(TheSTR, OldSize + NewStringEvenLength);
        OKSoFar := TestMemErr;
{If everything is OK, then copy the new string into the handle.}
        if OkSoFar then
            begin
                HLock(TheSTR);

{Figure out where the current end of the block is.}
                BlockMove(TheSTR^, @OldNumberOfStrings, 2);
                CurrentOffset := 2;
                if OldNumberOfStrings > 0 then
                    for counter := 1 to OldNumberOfStrings do
                        begin
                            ScratchPtr := Ptr(LongInt(TheSTR^) + CurrentOffset);
                            StringLength := ScratchPtr^;
                            StringLength := MakeEven(StringLength + 1);
                            CurrentOffset := CurrentOffset + StringLength;
                        end;

{Copy the string into there.}
                ScratchPtr := Ptr(LongInt(TheSTR^) + CurrentOffset);
                BlockMove(@TheString, ScratchPtr, NewStringEvenLength);

{Update the count of strings.}
                NewNumberOfStrings := OldNumberOfStrings + 1;
                BlockMove(@NewNumberOfStrings, TheSTR^, 2);

                HUnlock(TheSTR);
            end;

        AddToSTR := NewNumberOfStrings;
        if not OkSoFar then
            AddToSTR := -1;
    end;

{This function searches for a given string and returns its index.  If we can't find it,}
{we return 0.}
    function FindInSTR; {(TheSTR:  Handle , TheString: string): Integer;}
        var
            Index, CurrentOffset, TopStrings: Integer;
            StringLength: Byte;
            CheckString: Str255;
            done, foundIt: Boolean;
            ScratchPtr: Ptr;
    begin
        Index := 0;
        BlockMove(TheSTR^, @TopStrings, 2);  {Get the number of strings.}
        CurrentOffset := 2;
        done := false;
        foundIt := false;
        if TopStrings > 0 then
{Loop through the strings until we find a match or until we've gone through them all.}
            while not done do
                begin
                    Index := Index + 1;
                    ScratchPtr := Ptr(LongInt(TheSTR^) + CurrentOffset);
                    StringLength := ScratchPtr^;
                    StringLength := MakeEven(StringLength + 1);
                    BlockMove(ScratchPtr, @CheckString, StringLength);
                    if EqualString(CheckString, TheString, false, true) then
                        begin
                            done := true;
                            foundIt := true;
                        end
                    else
                        begin
                            CurrentOffset := CurrentOffset + StringLength;
                        end;
                    if Index = TopStrings then
                        done := true;
                end;
        if FoundIt then
            FindInSTR := Index
        else
            FindInStr := 0;
    end;

{This function, given an index, returns a string.  If the index is out of range, we}
{return an empty string.}
    function ExtractSTR; {(TheSTR: Handle, TheIndex: Integer): Str255;}
        var
            CurrentOffset, TopStrings, counter: Integer;
            StringLength: Byte;
            TheString: Str255;
            ScratchPtr: Ptr;
    begin
        BlockMove(TheSTR^, @TopStrings, 2);
        CurrentOffset := 2;
        TheString := '';
        if (TopStrings > 0) and (TheIndex <= TopStrings) then
            begin
                for counter := 1 to TheIndex - 1 do
                    begin
                        ScratchPtr := Ptr(LongInt(TheSTR^) + CurrentOffset);
                        StringLength := ScratchPtr^;
                        StringLength := MakeEven(StringLength + 1);
                        CurrentOffset := CurrentOffset + StringLength;
                    end;
                ScratchPtr := Ptr(LongInt(TheSTR^) + CurrentOffset);
                StringLength := ScratchPtr^;
                StringLength := MakeEven(StringLength + 1);
                BlockMove(ScratchPtr, @TheString, StringLength);
            end;
        ExtractSTR := TheString;
    end;



{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}


    procedure MiscAlert (AlertString: Str255);
        var
            result: integer;
    begin
        InitCursor;
        ParamText(AlertString, '', '', '');
        result := Alert(OKAlert, nil);
    end;

    function MiscInquiry (AlertString: Str255): integer;
        var
            result: integer;
    begin
        InitCursor;
        ParamText(AlertString, '', '', '');
        result := Alert(OkAndCancelAlert, nil);
        MiscInquiry := result;
    end;

    procedure MiscAlertStr (rsrcID, index: Integer);
        var
            AlertString: Str255;
    begin
        GetIndString(AlertString, rsrcID, index);
        MiscAlert(AlertString);
    end;

    function MiscInquiryStr (rsrcID, index: Integer): integer;
        var
            result: integer;
            AlertString: Str255;
    begin
        GetIndString(AlertString, rsrcID, index);
        result := MiscInquiry(AlertString);
        MiscInquiryStr := result;
    end;


{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

    procedure doOSErr;  {This posts an alert for unexpected errors.}
        const
            MyErrorsSTR = 129;
        var
            ResultString: Str255;
            ErrorString: Str255;
            ignore: integer;
    begin
        InitCursor;
        case result of
{You should edit these case selectors and create a STR# resource appropriate for your application.}
            -33, -34: {Disk full}
                GetIndString(ErrorString, MyErrorsSTR, 2);
            -44, -45, -46, -47:  {File locked or busy.}
                GetIndString(ErrorString, MyErrorsSTR, 3);
            -41:  {Out of memory. }
                GetIndString(ErrorString, MyErrorsSTR, 4);
            otherwise  {Huh?  Don't know this error type.  Just post a generic message and the number.}
                begin
                    GetIndString(ErrorString, MyErrorsSTR, 1);  {"An unexpected error has occurred."}
                    NumToString(result, ResultString);
                    ErrorString := Concat(ErrorString, ResultString);
                end;
        end;
        ParamText(ErrorString, '', '', '');
        ignore := Alert(1001, nil);  {Our generic stop alert}
    end;


{This routine allows us to reduce a lot of the coding overhead involved when doing memory}
{operations.}
    function TestMemErr: Boolean;
        var
            OkSoFar: Boolean;
    begin
        OkSoFar := true;
        if MemError <> 0 then
            begin
                OkSoFar := false;
                doOSErr(MemError);
            end;
        TestMemErr := OkSoFar;
    end;

    function TestResErr: Boolean;
        var
            OkSoFar: Boolean;
    begin
        OkSoFar := true;
        if ResError <> 0 then
            begin
                OkSoFar := false;
                doOSErr(ResError);
            end;
        TestResErr := OkSoFar;
    end;

    function TestNilRsrc (TheRsrc: Handle): Boolean;
        var
            OkSoFar: Boolean;
    begin
        OkSoFar := true;
        if TheRsrc^ = nil then
            begin
                OkSoFar := false;
                doOSErr(GotNilResource);
            end;
{I'm not sure which is right, so I'll do it both ways.}
        if TheRsrc = nil then
            begin
                OkSoFar := false;
                doOSErr(GotNilResource);
            end;
        TestNilRsrc := OkSoFar;
    end;


    function GetResOK (TheRsrc: Handle): Boolean;
        var
            OkSoFar: Boolean;
    begin
        OkSoFar := TestResErr;

        if OkSoFar then
            OkSoFar := TestNilRsrc(TheRsrc);

        GetResOK := OkSoFar;
    end;


    function TestOSResult (Result: Integer): Boolean;
        var
            OkSoFar: Boolean;
    begin
        OkSoFar := TRUE;
        if Result <> 0 then
            begin
                OkSoFar := False;
                doOSErr(Result);
            end;
        TestOSResult := OkSoFar;
    end;


{This function determines whether we have enough memory to go ahead with a particular function, such}
{as opening a certain dialog.  MemNeeded is the estimated amount of memory needed to perform this function.}
{FailStringIndex is the index to a STR# resource, which puts up the appropriate message in an alert if we don't}
{have enough memory.}
    function Preflight; {(MemNeeded, FailStringIndex): Boolean;}
        const
            PreflightStrings = 128;
        var
            ignore: integer;
            MessageString: Str255;
            TotalBytes, ContigBytes: LongInt;
    begin
        Preflight := TRUE;  {Let's assume everything is OK.}
        PurgeSpace(TotalBytes, ContigBytes);   {How much memory is there?}
        if MemNeeded > ContigBytes then   {Is that enough memory?}
            begin
                MiscAlertStr(PreflightStrings, FailStringIndex);  {Put up the alert.}
                Preflight := FALSE;   {and report back to the calling routine that there's not enough space.}
            end;
    end;


{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}


{As noted above, you must write your own doUpdateUserItem routine which redraws the user items}
{in your dialogs.}
    procedure doUpdateUserItem (whichWindow: WindowPtr; Item: Integer);
    external;

    procedure UpdateUserItem (whichWindow: WindowPtr; Item: Integer);
    begin
        doUpdateUserItem(whichWindow, Item);
    end;

    procedure LinkUserItem (WhichDialog: DialogPtr; WhichItem: Integer);
        var
            IgnoreType: Integer;
            IgnoreHandle: Handle;
            IgnoreRect: Rect;
    begin
        GetDItem(WhichDialog, WhichItem, IgnoreType, IgnoreHandle, IgnoreRect);
        SetDItem(WhichDialog, WhichItem, IgnoreType, @UpdateUserItem, IgnoreRect);
    end;

    function GetDRect (theDialog: DialogPtr; theItem: Integer): Rect;
        var
            IgnoreType: Integer;
            IgnoreHandle: Handle;
    begin
        GetDItem(theDialog, theItem, IgnoreType, IgnoreHandle, GetDRect);
    end;

    function GetDHandle (theDialog: DialogPtr; theItem: Integer): Handle;
        var
            IgnoreType: Integer;
            IgnoreRect: Rect;
            TempHandle: Handle;
    begin
        GetDItem(theDialog, theItem, IgnoreType, TempHandle, IgnoreRect);
        GetDHandle := TempHandle;
    end;

    function GetDControl (theDialog: DialogPtr; theItem: Integer): ControlHandle;
        var
            IgnoreType: Integer;
            IgnoreRect: Rect;
            TempHandle: Handle;
    begin
        GetDItem(theDialog, theItem, IgnoreType, TempHandle, IgnoreRect);
        GetDControl := ControlHandle(TempHandle);
    end;

    procedure SetDText (theDialog: DialogPtr; theItem: Integer; theString: Str255);
        var
            IgnoreType: Integer;
            IgnoreRect: Rect;
            TempHandle: Handle;
    begin
        GetDItem(TheDialog, TheItem, IgnoreType, TempHandle, IgnoreRect);
        SetIText(TempHandle, theString);
    end;

    procedure SetDRect (theDialog: DialogPtr; theItem: Integer; theRect: Rect);
        var
            IgnoreType: Integer;
            IgnoreRect: Rect;
            IgnoreHandle: Handle;
    begin
        GetDItem(TheDialog, TheItem, IgnoreType, IgnoreHandle, IgnoreRect);
        SetDItem(TheDialog, TheItem, IgnoreType, IgnoreHandle, theRect);
    end;


{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

    procedure InitWatch;
    begin
        WatchHandle := GetCursor(WatchCursor);
    end;

    procedure ShowWatch;
{Set cursor to watch}
{We have no routine ShowPointer, because we can simply say InitCursor.}
    begin
        SetCursor(WatchHandle^^);
    end;

{This routine is called when we first start want to display the moving watch cursor.}
    procedure StartSpinningWatch;
        var
            counter: Integer;
    begin
        for counter := 1 to 7 do
            SpinningWatchHandle[counter] := GetCursor(Counter + 256);
        SpinningWatchState := 8;
        SpinningWatchTimer := TickCount;
    end;

{This routine is called when we want to rotate the watch to the next position.  We should}
{just call this routine as often as possible; this routine worries about the timing.}
    procedure SpinWatch;
        var
            NewTime: LongInt;
    begin
        NewTime := TickCount;
        if (NewTime - 30) > SpinningWatchTimer then
            begin
                SpinningWatchState := SpinningWatchState + 1;
                SpinningWatchTimer := NewTime;
                if SpinningWatchState > 8 then
                    SpinningWatchState := 1;
                if SpinningWatchState = 8 then
                    ShowWatch
                else
                    SetCursor(SpinningWatchHandle[SpinningWatchState]^^);
            end;
    end;

{This routine deallocates the memory we used and inits the cursor.}
    procedure StopSpinningWatch;
        var
            counter: Integer;
    begin
        for counter := 1 to 7 do
            ReleaseResource(Handle(SpinningWatchHandle[counter]));
    end;


{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{Drawing routines for popup menus.}

    var
        TheTriangleRgn: RgnHandle;

    procedure InitPopUpTriangle;
    begin
        TheTriangleRgn := NewRgn;
        OpenRgn;
        MoveTo(0, 0);
        LineTo(14, 0);
        LineTo(7, 7);
        LineTo(0, 0);
        CloseRgn(TheTriangleRgn);
    end;

    procedure DrawPopupMenu (StartRect: Rect; TitleString: Str255);
        var
            TrianglePict: PicHandle;
            TriangleRect: Rect;
            TriangleRgnRect: Rect;
            MenuRect: Rect;
    begin
        MenuRect := StartRect;
        MenuRect.right := MenuRect.right - 1;
        MenuRect.bottom := MenuRect.bottom - 1;
{Frame the rect.}
        frameRect(MenuRect);
{Draw the drop shadow.}
        MoveTo(MenuRect.Right, MenuRect.Top + 1);
        LineTo(MenuRect.Right, MenuRect.Bottom);
        LineTo(MenuRect.Left + 1, MenuRect.Bottom);
{Draw the down arrow.}
        TriangleRgnRect := TheTriangleRgn^^.RgnBBox;
        TriangleRect.Top := MenuRect.Top + 4;
        TriangleRect.Bottom := TriangleRect.Top + (TriangleRgnRect.Bottom - TriangleRgnRect.Top);
        TriangleRect.Right := MenuRect.Right - 5;
        TriangleRect.Left := TriangleRect.Right - (TriangleRgnRect.Right - TriangleRgnRect.Left);

        MoveRgnTo(TheTriangleRgn, TriangleRect);
        PaintRgn(TheTriangleRgn);

{Draw the title, truncating it and adding ellipses if necessary.}
        RenamePopupMenu(StartRect, TitleString);
    end;

    procedure RenamePopupMenu (TheRect: Rect; TitleString: Str255);
        var
            TitleRect: Rect;
            Width: Integer;
            ShortTitle: Str255;
    begin
        TitleRect := TheRect;
        InsetRect(TitleRect, 2, 2);
        TitleRect.right := TitleRect.right - 20;
        EraseRect(TitleRect);
        Width := TitleRect.Right - TitleRect.Left;
        ShortTitle := EllipsisString(TitleString, Width);
        MoveTo(theRect.Left + 4, theRect.Bottom - 5);
        DrawString(ShortTitle);
    end;


    function DoDialogPopUp (WhichDialog: DialogPtr; TitleDItem, PopUpDItem, StartSelection: Integer; theMenu: MenuHandle): Integer;
        var
            MenuPoint: Point;
            Result: Integer;
            TheRect: Rect;
    begin
        SetPort(WhichDialog);
        InvertRect(GetDRect(WhichDialog, TitleDItem));
        MenuPoint := GetDRect(WhichDialog, PopUpDItem).TopLeft;
        LocalToGlobal(MenuPoint);
        Result := PopUpMenuSelect(TheMenu, MenuPoint.v, MenuPoint.h, StartSelection);
        InvertRect(GetDRect(WhichDialog, TitleDItem));
        TheRect := GetDRect(WhichDialog, PopUpDItem);
        InsetRect(TheRect, 2, 2);
        InvalRect(TheRect);
        DoDialogPopUp := Result;
    end;


    procedure PlotAnyIcon (Icon: Handle; Mask: Ptr; Where: Rect);
    begin
{This routine glances at the ScreenDepth and determines from that what kind of icon this is.}
{It transfers this icon to the current port, using the b/w mask as a mask.}
    end;


{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{Create a new list with no elements.}
    procedure CreateList;
        const
            StandardList = 0;
        var
            ViewRect: Rect;
            DataBounds: Rect;
            CellSize: Point;
            TempInteger: Integer;  {Just to do a little math}
    begin
{Inset the box to make room for the scroll bar.  Also inset it so we've got room for a border.}
        ViewRect := TheRect;
        InsetRect(ViewRect, 1, 1);
        ViewRect.Right := ViewRect.Right - 15;
{Set the cell size to the size of the cell}
        CellSize.v := TheWindow^.txSize + 3;
        if CellSize.v = 3 then  {If it hasn't been set, then make it 12 point.}
            begin
                TextSize(12);
                CellSize.v := 15;
            end;
        CellSize.h := ViewRect.Right - ViewRect.Left;
{Now adjust the ViewRect to avoid cutting off the last visible cell}
        TempInteger := (ViewRect.Bottom - ViewRect.Top) div CellSize.v;
        ViewRect.Bottom := ViewRect.Top + (TempInteger * CellSize.v);
{Create the new list.}
        SetRect(DataBounds, 0, 0, 1, 0);
        TheListHandle := LNew(ViewRect, DataBounds, CellSize, StandardList, TheWindow, FALSE, FALSE, FALSE, TRUE);
        UpdateList(TheListHandle);
    end;

{Update the art of a list.}
    procedure UpdateList;
        var
            ViewRect: Rect;
            ListUpdateRgn: RgnHandle;
    begin
        SetPort(TheListHandle^^.Port);
{Get the List manager to update the list.}
        ViewRect := TheListHandle^^.rView;
        LDoDraw(true, TheListHandle);
        ListUpdateRgn := NewRgn;
        RectRgn(ListUpdateRgn, ViewRect);
        LUpdate(ListUpdateRgn, TheListHandle);
{Draw the border}
        InsetRect(ViewRect, -1, -1);
        FrameRect(ViewRect);
{Clean up after ourselves}
        DisposeRgn(ListUpdateRgn);
    end;

{Handle a click in the list rectangle.  If it was a double-click, we will return TRUE.}
    function DoClick;
    begin
        SetPort(TheListHandle^^.Port);
        LDoDraw(TRUE, TheListHandle);
        DoClick := LClick(TheWhere, 0, TheListHandle);
    end;

{Turn off any hilited item.}
    procedure TurnOffSelection;
        var
            ResultPoint: Point;
    begin
        SetPt(ResultPoint, 0, 0);
        if LGetSelect(TRUE, ResultPoint, TheListHandle) then
            LSetSelect(FALSE, ResultPoint, TheListHandle);
    end;

{Return the string currently selected; empty string if no selection.}
    function ListSelection;
        var
            ResultPoint: Point;
            ResultString: Str255;
            StringPointer: Ptr;
            StringLength: Integer;
    begin
        SetPt(ResultPoint, 0, 0);
        if LGetSelect(TRUE, ResultPoint, TheListHandle) then
{If there is a cell selected, then get the string value of that string.  There ought to be an}
{easier way to do this than mucking around in the memory like this.  >:-(    }
            begin  {If there is a cell selected, then return the string of the cell.}
                StringPointer := Ptr(Ord(@ResultString) + 1);
                StringLength := 255;  {This is the maximum amount of data we are allowed to move.}
                LGetCell(StringPointer, StringLength, ResultPoint, TheListHandle);
                StringPointer := Ptr(Ord(@ResultString));
                StringPointer^ := StringLength;
                ListSelection := ResultString;
            end
        else  {Otherwise, return the empty string to show that nothing is selected.}
            ListSelection := '';
    end;

{Add a new cell containing the string parameter to the end of the list}
    procedure AddCell;
        var
            Counter: Integer;
            CellPoint: Point;
            OldString: Str255;
            CompResult: Integer;
            StringLength: Integer;
            StringPointer: Ptr;
            done: Boolean;
    begin
{Step 1:  Circle through the loop and figure out where we should insert the new}
{cell.  We do this to put the list in alphabetical order, and to keep it that way as}
{new objects are added.}
        CellPoint.h := 0;
        CellPoint.v := 0;
        Done := false;
        while not done do
            begin
                if LNextCell(TRUE, TRUE, CellPoint, TheListHandle) then
                    begin
                        StringPointer := Ptr(Ord(@OldString) + 1);
                        StringLength := 255;  {This is the maximum amount of data we are allowed to move.}
                        LGetCell(StringPointer, StringLength, CellPoint, TheListHandle);
                        StringPointer := Ptr(Ord(@OldString));
                        StringPointer^ := StringLength;

                        CompResult := RelString(NewString, OldString, false, true);
                        case CompResult of
                            sortsBefore, sortsEqual:
                                done := true;
                            SortsAfter:
                                ;  {Try again!}
                        end;
                    end
                else
{There are no more rows, so that's all.}
                    begin
                        done := true;
                    end;
            end;

{Add the new row at the top of the list.}
        CellPoint.v := LAddRow(1, CellPoint.v, TheListHandle);
{Put the string into the cell.  Once again, there ought to be an easier way to do this.}
        LSetCell(Pointer(Ord(@NewString) + 1), Length(NewString), CellPoint, TheListHandle);
    end;


    procedure RenameCell;
        var
            CellPoint: Point;
            DataPtr: Ptr;
            DataLen: Integer;
    begin
        SetPt(CellPoint, 0, 0);
        DataPtr := Pointer(Ord(@OldString) + 1);
        dataLen := Length(OldString);
        if LSearch(dataPtr, dataLen, nil, CellPoint, TheListHandle) then
            begin
                DataPtr := Pointer(Ord(@NewString) + 1);
                dataLen := Length(NewString);
                LSetCell(DataPtr, dataLen, CellPoint, TheListHandle);
            end
        else
            begin
                Sysbeep(1);
                Sysbeep(1);
                Sysbeep(1);
            end;
    end;


{Remove the cell with the given name from the list.}
    procedure DeleteCell;
        var
            CellPoint: Point;
            DataPtr: Ptr;
            DataLen: Integer;
    begin
        SetPt(CellPoint, 0, 0);
        DataPtr := Pointer(Ord(@TheString) + 1);
        dataLen := Length(TheString);
        if LSearch(dataPtr, dataLen, nil, CellPoint, TheListHandle) then
            begin
                LDelRow(1, CellPoint.v, TheListHandle);
            end
        else
            begin
                Sysbeep(1);
                Sysbeep(1);
                Sysbeep(1);
            end;
    end;

{Get rid of the list when we're done with it, cleaning up all the memory.}
    procedure DisposList;
    begin
        LDispose(TheListHandle);
    end;

{Above is the list manager section.}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}



    function TrackHalfRect (ThisRect: Rect): Boolean;
{This routine basically does the same thing as the Toolbox routine TrackControl.}
{This routine is called when the mouse is clicked in the arrow picture.  It hilites}
{the half of the arrow clicked.  If the mouse moves out of the picture, the picture}
{is unhilited.  If it moves back in with button still held down, it is rehilited.}
{TrackHalfRect is TRUE if and only if the mouse is released in the same rectangle}
{that it was pushed in.}
        var
            IsInRect: Boolean;
            MouseLoc: Point;
    begin
        InvertRect(ThisRect);
        IsInRect := true;
        while Button do
            begin
                GetMouse(MouseLoc);
                if PtInRect(MouseLoc, ThisRect) then
                    if IsInRect then
{Do nothing}
                    else
                        begin
                            IsInRect := true;
                            InvertRect(ThisRect);
                        end
                else if IsInRect then
                    begin
                        IsInRect := false;
                        InvertRect(ThisRect);
                    end
                else
            end;
        if IsInRect then
            InvertRect(ThisRect);
        TrackHalfRect := IsInRect;
    end;

    function ArrowClick (ClickWhere: Point; ArrowRect: Rect): Integer;
{This routine handles a click in an up-down arrow 'control'.  It returns 1 if the up-arrow was clicked,}
{2 if the down-arrow was clicked, and 0 if neither was clicked (i.e., the mouse-up came outside the}
{control.}
        var
            UpRect, DownRect: Rect;
    begin
{First, we have to figure out what the rectangles are.}
{UpRect is set to the upper half of the picture rectangle.}
{DownRect is set to... well, you get the idea.}
        UpRect := ArrowRect;
        DownRect := ArrowRect;
        UpRect.Bottom := UpRect.Bottom - ((ArrowRect.Bottom - ArrowRect.Top) div 2);
        DownRect.Top := DownRect.Top + ((ArrowRect.Bottom - ArrowRect.Top) div 2);
        ArrowClick := 0;
        if PtInRect(ClickWhere, UpRect) then
            begin
                if TrackHalfRect(UpRect) then
                    ArrowClick := 1;
            end;
        if PtInRect(ClickWhere, DownRect) then
            begin
                if TrackHalfRect(DownRect) then
                    ArrowClick := 2;
            end;
    end;



end.